;<FOONEX>GTJFN.MAC;10 18-Mar-81 21:39:34, Edit by MMCM
; SUMEX GTJFN ADDITIONS
;DSK:<134-TENEX>GTJFN.MAC;7  2-Apr-80 15:52:06, Edit by RKNIGHT
; ^D is now EOL in GCH1.
;<134-TENEX>GTJFN.MAC;6    27-Jan-80 17:33:59    EDIT BY PETERS
; Fix KAFLG to KAFLG!F3FLG
;<134-TENEX>GTJFN.MAC;5    14-Feb-77 11:46:27    EDIT BY UNTULIS
;ADDED CODE TO LIMIT ACCESS TO FILES IN ENDAL2
;<134-TENEX>GTJFN.MAC;4     1-APR-76 13:16:27    EDIT BY UNTULIS
;FIXED ENDDEV ERROR RETURN
;<134-TENEX>GTJFN.MAC;3    15-MAR-76 09:35:54    EDIT BY UNTULIS
; FIX PROBLEM WITH LOWER CASE LETTERS IN DEFAULT STRINGS AT REDFL1+3
;<134-TENEX>GTJFN.MAC;2     5-FEB-76 17:19:32    EDIT BY UNTULIS
;ADDED DELCH JSYS CALL IN DELCH
;<134-TENEX>GTJFN.MAC;93    29-SEP-75 07:39:48    EDIT BY TOMLINSON
; ADD GNJFX2 ERROR FOR NO MORE FILES CASE
;<134-TENEX>GTJFN.MAC;92    10-JUL-75 12:54:22    EDIT BY CALVIN
; Fixed bug in user assigned JFN failure; ERRLJF becomes ERR
;<134-TENEX>GTJFN.MAC;2    27-JUN-75 10:49:27    EDIT BY ALLEN
; TCH=TCHK DUE TO CONFLICT WITH 370 CHANNEL OP CODE
;<134-TENEX>GTJFN.MAC;90    28-APR-75 15:04:41    EDIT BY CLEMENTS
;<134-TENEX>GTJFN.MAC;89    28-APR-75 12:15:07    EDIT BY CLEMENTS
;<134-TENEX>GTJFN.MAC;88    28-APR-75 11:33:18    EDIT BY CLEMENTS
;<134-TENEX>GTJFN.MAC;87    24-APR-75 16:21:29    EDIT BY CLEMENTS
;<134-TENEX>GTJFN.MAC;86    24-APR-75 14:15:37    EDIT BY CLEMENTS
;<134-TENEX>GTJFN.MAC;85    21-APR-75 11:18:22    EDIT BY TOMLINSON
; Print "Confirm" rather than "OK" for non-directory devices
;<133-TENEX>GTJFN.MAC;84    25-SEP-74 12:57:44    EDIT BY TOMLINSON
; FIX TYPO AT GTJFZ1+6 TO OUTLAW JFNS 100 AND 101
;<TENEX-132>GTJFN.MAC;83    13-MAY-74 09:03:34    EDIT BY TOMLINSON
; ADDED CHECKS ON CHARACTERS > 177 IN GCH AND REDFLT
;<TRAP>GTJFN.MAC;1     4-MAR-74 14:13:08	EDIT BY BTHOMAS
;<TENEX-132>GTJFN.MAC;81    10-FEB-74 21:52:08	EDIT BY PLUMMER
; FIX REDFLT TO ALLOW FULL 39-CHR DEFAULT STRINGS
;<TENEX-132>GTJFN.MAC;80    31-JAN-74 12:03:29	EDIT BY TOMLINSON
; PRINT CONFIRM IN ALL REQUIRED CASES
;<TENEX-132>GTJFN.MAC;79    23-NOV-73 17:38:17	EDIT BY CLEMENTS
;<TENEX-132>GTJFN.MAC;78     9-NOV-73 20:15:53	EDIT BY CLEMENTS
; KI CHANES, FIX FOR RELJFN(UNASSIGNED JFN)
;<TENEX-132>GTJFN.MAC;77     2-NOV-73 13:21:37	EDIT BY TOMLINSON
; ALLOW OUTPUT STARTS AT STAR+1
;<TENEX-132>GTJFN.MAC;76    13-JUN-73 21:52:02	EDIT BY CLEMENTS
;<TENEX-132>GTJFN.MAC;75    13-JUN-73 21:10:32	EDIT BY CLEMENTS
;<TENEX-132>GTJFN.MAC;74    28-MAY-73 12:46:49	EDIT BY CLEMENTS
; Fixed glitch in cctab
;<TENEX-132>GTJFN.MAC;73    25-MAY-73 22:05:52	EDIT BY CLEMENTS
;<TENEX-132>GTJFN.MAC;72    25-MAY-73 10:48:26	EDIT BY TOMLINSON
; GNJFN BUG FOR DELETED FILES
;<TENEX-132>GTJFN.MAC;71    17-MAY-73 00:07:30	EDIT BY CLEMENTS
;<TENEX-132>GTJFN.MAC;70    16-MAY-73 01:20:33	EDIT BY CLEMENTS
;<TENEX-132>GTJFN.MAC;69    14-MAY-73 12:00:33	EDIT BY TOMLINSON
; Added scratch file code
;<TENEX-132>GTJFN.MAC;68     9-MAY-73 19:05:03	EDIT BY TOMLINSON
; Fixed version defaulting for ;t files
;<TENEX-132>GTJFN.MAC;67     6-MAR-73 18:25:13	EDIT BY CLEMENTS
;<TENEX-132>GTJFN.MAC;66    13-FEB-73 19:06:19	EDIT BY CLEMENTS
; GNJFN PATCH FOR NEW EXT BIT, AS DISTRIBUTED
;<TENEX-130>GTJFN.MAC;65    28-DEC-72 13:57:17	EDIT BY TOMLINSON
; NO "ECHO" OF TERMINATOR FROM STRING
;<TENEX-130>GTJFN.MAC;64     9-NOV-72 21:05:59	EDIT BY TOMLINSON
;<TENEX-130>GTJFN.MAC;63     6-NOV-72 11:48:09	EDIT BY TOMLINSON
; STRNAM+3/ JUST ERRDO, ENDAL5: DON'T RETURN EXTXF
;<DLM/TEMP>GTJFN.MAC;62    30-OCT-72 18:05:36	EDIT BY TOMLINSON
;<DLM/TEMP>GTJFN.MAC;61    30-OCT-72 17:38:32	EDIT BY TOMLINSON
; FIXES FOR STARS, ? ADDED
;<FILESYSTEM>GTJFN.MAC;60    25-AUG-72 17:32:04	EDIT BY TOMLINSON
;<FILESYSTEM>GTJFN.MAC;59    29-JUN-72  9:57:33	EDIT BY TOMLINSON

	SEARCH	STENEX,PROLOG
	TITLE	GTJFN	; & gnjfn
	SUBTTL	R.S.Tomlinson

EXTERN	MINUS1,BHC,FKDIR,FORKX,MENTR,MRETN,ERRSAV,CAPENB,LSTERR
EXTERN	ACCCHK,ACCTPT,ACCTSR,ASGJFR,CHKJFN,CPOPJ,DBP,DEVLUK,DIRCHK
EXTERN	DIRLKX,DIRLUK,ERRD,ERUNLD,EXTLKX,EXTLUK,GDIRST,GETFDB,MDDNAM
EXTERN	MODES,NAMLKX,NAMLUK,RELFRE,SKMRTN,SKPRET,UNLCKF,USTDIR,VERLUK
EXTERN	VERLKX,JOBDIR,MDDDIR,TTYDTB,FORKX,FKDIR

EXTERN	NXTDMP		; Zero this to cause open files to be written
EXTERN	MPP		; Saved push pointer on entry to gtjfn

DEFINE	TMSG(M)<
	HRROI B,[ASCIZ M]
	PUSHJ P,TSTR>

DEFINE	CHOUT(C)<
	MOVEI B,C
	PUSHJ P,OUTCH>

DEFINE	ERUNLK(ERRORN,EXTRA)<
JRST [	EXTRA
	IFDIF <ERRORN>,<>,<MOVEI A,ERRORN>
	JRST ERUNLD]>

DEFINE	ERR(ERRORN,EXTRA)<
JRST [	EXTRA
	IFDIF <ERRORN>,<>,<MOVEI A,ERRORN>
	JRST ERRD]>

DEFINE	ERRLJF(N,EXTRA)<
JRST	[EXTRA
	IFDIF <N>,<>,<MOVEI A,N>
	JRST ERRDO]>

DEFINE	CHRTP(C)<
	MOVEI A,C
	PUSHJ P,RTPCH>

DEFINE	RTPMSG(M)<
	HRROI A,[ASCIZ M]
	PUSHJ P,RTSTR>

DEFINE	RTPFLG(RFLAG)<
	MOVSI A,RFLAG
	HRRZ B,FILEXW(JFN)
	IORM A,BLKFG(B)>


; * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
; *  [SUMEX] Definitions and additional routines for SUMEX extensions *
; *  to GTJFN are found in GTJSMX.MAC.  These include:		      *
; *       Imbedded wild cards (* and %)				      *
; *       Backing up over fields				      *
; *       Interactive partial directory (? feature)		      *
; *       Partial field recognition (to point of ambiguity)	      *
; *       Extended long call (similar to TOPS-20)		      *
; * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

; Get a jfn for a file name
; Call:	1	; E
;	2	; String designator
;	GTJFN
; Or
;	LH(1)		; Flags (bit 17 = 1)
;	RH(1)		; Default version
;	2		; String designator or xwd infile,outfile
;	GTJFN
; Return
; +1 error, in 1, error code
; +2 ok, in 1, the jfn for the file

;	LH(E)	; Flags
;	RH(E)	; Default version
;	LH(E+1)	; Input jfn (377777 means none)
;	RH(E+1)	; Output jfn (377777 means none)
;	E+2	; Default string pointer device
;	E+3	; Default string pointer directory
;	E+4	; Default string pointer name
;	E+5	; Default string pointer extension
;	E+6	; Default string pointer protection
;	E+7	; Default string pointer account
;	E+10	; Desired jfn if jfnf=1 (optional)

;  [SUMEX CHANGE]  If flag bit 15 (LLTBF) is on in long GTJFN, the
;  following 4 locations are used:
;
;    LH(E+11)	; Additional control flags (see TOPS-20 GTJFN)
;		   Bit 0 - Break if del past start of input
;		       1 - Unassigned
;		       2 - Names LE 6 chars and Ext LE 3 (Not implemented)
;		       3 - Return confirmation msg with typescript
;     [set on return]  4 - File is on "no name" device (NNAMF)
;     [set on return]  5 - File has name but no version #s (NVERF)
;     [set on return]  6 - File is "new" (NEWF)
;     [set on return]  7 - File is a "new version" (NEWVF)
;    RH(E+11)	; Number of extended table words following
;	E+12	; String ptr to user typescript buffer 
;	E+13	; Size of typescript buffer in characters (default MAXRC)
;	E+14	; String ptr to Prompt string output before retyping

; If a default string pointer is 0, then it is assumed unspecified
; If the lh of a default string pointer is 777777, 440700 is assumed

; Parameters

MAXLC==:^D39
MAXLW==:8

TTYDV=12		; Device code for TTY
NDIG==6			; Max number of digits in prot and acct


; Table of byte pointers for getting character class

CCSIZE==:5			; Width of character class field
CCBPW==:^D36/CCSIZE

	RADIX ^D10

Q==CCSIZE-1

CPTAB::	REPEAT ^D36/CCSIZE,<
	POINT CCSIZE,CCTAB(B),Q
Q==Q+CCSIZE>

	RADIX 8

; Character classification table

DEFINE	CCN(C,N)<
	REPEAT N,<CC1(C)>>

DEFINE	CC1(C)<
QQ==QQ+CCSIZE
IFG QQ-^D35,<
	QW
QW==0
QQ==CCSIZE-1>
QW==QW+<C>B<QQ>>

QQ==-1
QW==0

CCTAB:	CC1(17)			; Null
	CC1(2)			; Control-a
	CCN 17,4		; Control-b to e
	CC1(3)			; Control-f
	CCN 17,2		; Control-g & h
	CCN 7,2			; Control-i, j
	CC1(17)			; Control-k
	CCN 7,2			; Control-l, m (ff carret)
	CCN 17,4		; Control-n - q
	CC1(4)			; Control-r
	CCN 17,2		; Control-s, t
	CC1(6)			; Control-u
	CC1(16)			; Control-v
	CC1(5)			; Control-w
	CC1(6)			; Control-x
	CCN 17,2		; Control-y & z
	CC1(10)			; Alt-mode
	CCN 17,3		; 34-36
	CC1(7)			; Eol
	CC1(7)			; Space
	CCN 0,4			; ! to $
	CC1(20)			; %
	CCN 0,4			; & to )
	CC1(20)			; Asterisk
	CC1(0)			; +
	CC1(7)			; Comma
	CC1(30)			; -
	CC1(14)			; Dot
	CC1(0)			; Slash
	CCN 21,12		; Digits
	CC1(11)			; Colon
	CC1(15)			; Semi-colon
	CC1(12)			; <
	CC1(0)			; =
	CC1(13)			; >
	CC1(31)			; ?
	CC1(7)			; @
	CC1(24)			; A
	CCN 0,16		; B - O
	CC1(23)			; P
	CCN 0,2			; Q - R
	CC1(32)			; S
	CC1(22)			; T
	CCN 0,6			; U - z
	CCN 0,4			; [\]^
	CC1(7)			; _
	CC1(17)			; Acute accent
	CC1(27)			; Lower case a
	CCN 1,16		; Lower case b - o
	CC1(26)			; Lower case p
	CCN 1,2			; Lower case q - r
	CC1(33)			; Lower case s
	CC1(25)			; Lower case t
	CCN 1,6			; Lower case u - z
	CCN 17,4		; Curly brackets, vert bar, tilde
	CC1(2)			; Rubout

	QW

.GTJFN::JSYS MENTR		; Enter slow code
	MOVE E,A		; Set pointer to parameter block
	TLNE E,777777		; Lh is non-zero?
	HRRI E,1		; Point to ac's
	XCTUU [HLLZ F,0(E)]	; Get flags from user
	SETZB F1,STS		; Clear f1 & sts
	TEST(NN,TMPFF)		; Temp file requested?
	TEST(O,SCRF)		; No, use regular defaulting
	TEST(NE,NACCF)
	TEST(O,FRKF)
	TLNE E,2		; Is 2 a pointer
	JRST GTJFZ		; No, skip the following
	XCTUU [HLRZ A,2]	; Get lh of byte pointer
	HRLZI B,(<POINT 7,0>)
	TRNN A,777777
	XCTUU [SETZM 2]		; Clear pointer if lh = 0
	CAIN A,777777
	XCTUU [HLLM B,2]	; Put 7 bit byte into lh if -1
	CAIE A,0		; Does string pointer exist?
	TEST(OA,STRF)		; Yes it does
GTJFZ:	TEST(Z,STRF)		; No it does not
	PUSHJ P,INFTST
	JRST GTJFZ1
	RFCOC
	PUSH P,B
	PUSH P,C
	RFMOD
	PUSH P,B
	PUSH P,A
	TRZ B,777700
	IORI B,164100
	SFMOD
	PUSHJ P,SFCC0
GTJFZ1:	TLNN E,777777		; Can't specify jfn if short form
	TEST(NN,JFNF)		; Is user trying to specify jfn?
	JRST GTJF1		; No.
	XCTUU [SKIPL JFN,10(E)]	; Yes, get his version of jfn
	CAIL JFN,MJFN
	JRST	[MOVEI A,GJFX1
		 JRST ERRDO1 ]
	CAIE JFN,100		; Can't specify primary I/O jfn's
	CAIN JFN,101
	JRST	[MOVEI A,GJFX1
		 JRST ERRDO1 ]
GTJFZ2:

	NOINT
	LOCK JFNLCK
	CAML JFN,MAXJFN		; Above currently available jfn's?
	 JRST [	PUSH P,JFN	; Yes, sve this
		MOVE JFN,MAXJFN
		AOS MAXJFN
		LSH JFN,SJFN
		PUSHJ P,RELJF2
		POP P,JFN
		JRST GTJFZ2]
	LSH JFN,SJFN		; CONVERT TO TABLE INDEX
	SKIPN FILSTS(JFN)	; Is this jfn free?
	JRST [	PUSHJ P,ASGJF1	; Yes, assign it
		JRST GTJF0]
	UNLOCK JFNLCK
	OKINT
	TEST(NN,JFNAF)
	JRST	[MOVEI A,GJFX2
		 JRST ERRDO1]
GTJF1:	PUSHJ P,ASGJFN
	ERR(GJFX3)		; Jfn not available
GTJF0:	PUSHJ P,SETTMP		; Set up temporary string block
	PUSHJ P,SETRTP		; Set up retype buffer
GTJF2:	TEST(Z,NREC)		; Turn recognition back on
	PUSHJ P,GCH		; Get next character
	JRST ENDALL		; No more input
	ANDI A,177		; Only can have 7 bits
	TEST(ZE,CNTVF)		; Control-v pending?
	JRST [	PUSHJ P,UCCH	; Yes, ignore any special meanings
		PUSHJ P,RTPCH	; Add this char to the retype buffer
		JRST GTJF2]
	MOVE B,A
	IDIVI B,^D36/CCSIZE	; Prepare to get character class
	LDB B,CPTAB(B+1)	; Get character class
	CAIL B,ECHDTB-CHDTB
	ERRLJF GJFX4,<MOVEM A,ERRSAV>
	PUSH P,B		; Save dispatch index
	CAILE B,1		; If LC or UC letter
	CAILE B,10		; and not ^A to esc
	 JRST   [CAIE B,31	; and not ?
		  PUSHJ P,RTPCH	; Add char to retype buffer
		 JRST .+1]
	POP P,B
	XCT CHDTB(B)		; Execute the dispatch table
	JRST GTJF2		; Most action characters return here
	JRST GTJF2		; Some things skip for other reasons

; Character dispatch table

CHDTB:	PUSHJ P,UCCH		; (0) upper case letter
	PUSHJ P,LCCH		; (1) lower case letter
	PUSHJ P,DLCHR		; (2) cont-a
	PUSHJ P,RECFLD		; (3) cont-f
	PUSHJ P,RETYPE		; (4) cont-r
	PUSHJ P,DELFLD		; (5) cont-w
	PUSHJ P,DELALL		; (6) cont-x
	JRST ENDALL		; (7) cr, lf, ff, tab, _, ,, space, eol
	JRST RECALL		; (10) alt-mode
	PUSHJ P,ENDDEV		; (11) colon
	PUSHJ P,BEGDIR		; (12) <
	PUSHJ P,ENDDIR		; (13) >
	PUSHJ P,ENDNAM		; (14) .
	PUSHJ P,ENDEXT		; (15) ;
	TEST(O,CNTVF)		; (16) control-v
	ERRLJF GJFX4,<MOVEM A,ERRSAV>	; (17) illegal character
	PUSHJ P,STAR	; (20) asterisk
	PUSHJ P,DIGIT		; (21) digits
	PUSHJ P,TCHK		; (22) t
	PUSHJ P,PCH		; (23) p
	PUSHJ P,ACH		; (24) a
	PUSHJ P,LCTCH		; (25) lower case t
	PUSHJ P,LCPCH		; (26) lower case p
	PUSHJ P,LCACH		; (27) lower case a
	PUSHJ P,MINUS		; (30) minus sign
	PUSHJ P,QUEST		; (31) ?
	PUSHJ P,SCH		; (32) S
	PUSHJ P,LCSCH		; (33) s
ECHDTB:

; Continuation of gtjfn code

; Digits

DIGIT:	TEST (Z,KEYFF)		; Can't be a key letter anymore
	MOVE C,FILCNT(JFN)
	CAIGE C,MAXLC-7		; String longer than 7 digits
	JRST UCCH
	TEST(NE,OCTF)
	CAIGE A,"8"
	TEST(NN,NUMFF)		; Or not collecting number
	JRST UCCH		; Treat as letter
	MOVEI B,12
	TEST(NE,OCTF)
	MOVEI B,10
	IMUL NUM,B		; Otherwise collect number
	TEST(NN,NEGF)
	ADDI NUM,-60(A)
	TEST(NE,NEGF)
	SUBI NUM,-60(A)
	JRST LTR		; Also pack into string

; Simple characters

LCCH:	SUBI A,40		; Convert lower case to upper
UCCH:	TEST(Z,NUMFF,KEYFF)	; Number and key letter are invalid now
LTR:	SOSGE FILCNT(JFN)
	ERRLJF GJFX5		; String too long
	IDPB A,FILOPT(JFN)	; Append character to string
	POPJ P,

; Letter a

ACH:	TEST(ZN,KEYFF)		; Are we looking for a key letter?
	JRST UCCH		; No. treat same as other letter
ACH1:	TEST(NE,ACTF)		; Already have account?
	ERRLJF GJFX12		; Yes. syntax error
	TEST(O,ACTFF,NUMFF)	; We are now collecting account number
	POPJ P,

LCACH:	TEST(ZN,KEYFF)		; Same as for upper case a above
	JRST LCCH
	JRST ACH1

; Letter p

PCH:	TEST(ZN,KEYFF)		; Are we looking for key letter?
	JRST UCCH		; No. treat as for letter
PCH1:	TEST(NE,PRTF)		; Already have protection?
	ERRLJF GJFX13		; Yes, illegal syntax
	TEST(O,PRTFF,NUMFF)
	TEST(O,OCTF)
	POPJ P,

LCPCH:	TEST(ZN,KEYFF)
	JRST LCCH
	JRST PCH1

; Letter t

TCHK:	TEST(ZN,KEYFF)		; Looking for key?
	JRST UCCH		; No. treat as letter
TCH1:	TEST(Z,SCRTF)		; Clear scratch flag if on
	TEST(Z,SCRF)		; and scratch version defaulting flag
	TEST(NE,VERF)		; Already have version?
	 JRST [HRRZ A,FILVER(JFN)	; Is it really above 100000?
	       CAIG A,^D100000
	        JRST SCH1	; No, make this a scratch file
	       JRST .+1]	; OK, leave it temp
	TEST(O,TMPFF)		; Yes. set temp file flags
	TEST(O,TMPTF)
	TEST(O,TSFF)		; And say we just got it
	POPJ P,

LCTCH:	TEST(ZN,KEYFF)
	JRST LCCH
	JRST TCH1


; Letter S

SCH:	TEST(ZN,KEYFF)		; Looking for key?
	JRST UCCH		; No. treat as letter
SCH1:	TEST(Z,TMPTF)		; Clear temporary flag if on
	TEST(NE,VERF)		; Already have version?
	 JRST [HRRZ A,FILVER(JFN)	; Is it really below 100000?
	       CAILE A,^D100000
	        JRST TCH1	; No, make this a temp file
	       JRST .+1]	; OK, leave it temp
	TEST(O,TMPFF,SCRF)	; Yes. set scratch file flags
	TEST(O,SCRTF)
	TEST(O,TSFF)		; And say we just got it
	POPJ P,

LCSCH:	TEST(ZN,KEYFF)
	JRST LCCH
	JRST SCH1

; Minus sign

MINUS:	JUMPN NUM,UCCH		; If any number has been typed
	TEST(OE,NEGF)
	JRST UCCH		; Or 2 minus signs, treat as letter
	JRST LTR

; Device name terminator (:)
; The string in the block addressed by tmpptr
; Is taken as a device. if the device exists, the string is saved
; As the device name for this file.
; Exits with tmpptr reset to a null string

ENDDEV:	TEST(NE,STARF)
	ERRLJF GJFX31
	TEST(OE,DEVF)
	ERRLJF GJFX6		; Device already specified (syntax)
	PUSHJ P,ENDSTR		; Terminate string, get lookup pointer
	PUSHJ P,DEVLUK		; Lookup device in device tables
	ERRLJF()		; No such device
	MOVEM DEV,FILDEV(JFN)	; Value of lookup is initial fildev
	PUSHJ P,ENDTMP		; Truncate block
	HRLM A,FILDDN(JFN)	; Store as device name
	OKINT
	TEST(O,DEVTF)		; Remember that device was typed in
	JRST SETTMP		; Reset temp block and return

; Directory name prefix (<)
; Sets dirff to remember that we are getting a directory name

BEGDIR:	TEST(NN,DIRF)		; Already have directory?
	TEST(OE,DIRFF)		; Or currently gettin one
	ERRLJF GJFX7		; Yes. syntax error
	MOVE C,FILCNT(JFN)	; Bracket must be first in field
	CAIE C,MAXLC
	 ERRLJF GJFX7
	POPJ P,

; Directory terminator (>)
; The string in tmpptr is taken as a directory name.
; If recognized, the corresponding directory number is saved
; As the directory number for this file.
; Exits with tmpptr reset to null

ENDDIR:	TEST(ZE,DIRFF)		; Were we collecting it?
	TEST(OE,DIRF)		; And do we not yet have it?
	ERRLJF GJFX8		; No. error in syntax
	TEST(NN,DEVF)		; Do we have a device yet?
	PUSHJ P,DEFDEV		; No. default it first
	TEST(ZE,STARF)
	JRST   [TEST(NN,ASTAF,OSTRF)  ; User typed wild card - allowed?
		 ERRLJF GJFX31	      ; No
		JRST STRDIR]	      ; OK, handle it
	PUSHJ P,ENDSTR		; Terminate string, get lookup pointer
	PUSHJ P,DIRLKX		; Lookup directory (no recognition)
	JFCL
	ERRLJF GJFX17		; No such directory
ENDDI1:	HRRM A,FILDDN(JFN)	; Save directory number
	TEST(O,DIRTF)		; Remember that directory was typed in
	JRST SETTMP		; Reset temp block and return

STRDIR:	TEST(O,DIRSF,STEPF)	; Wild card and step to 1st one
	PUSHJ P,ENDTMP		; Trim FILTMP
	HRLM A,FILDNW(JFN)	; Save template for later
	OKINT
	MOVEI A,0		; First try
	PUSHJ P,@DLUKD(DEV)	; Find acceptable candidate
	 JFCL
	 ERRLJF GJFX17		; None there
	PUSHJ P,USTDIR		; Release directory
	TEST(Z,STEPF)		; Done stepping
	JRST ENDDI1		; And save the result


; Name terminator (.)
; The string in tmpptr is taken as a file name.
; If found, the string is saved as the file name of this file.
; Exits with tmpptr reset to null

ENDNAM:	TEST(OE,NAMF)		; Do we already have a name?
	 JRST  [TEST(NE,EXTF)	; Already have extension?
		 ERRLJF GJFX11	; Yes, syntax error
		TEST(O,NUMFF)	; No, assume this is it - version must follow
		JRST ENDEXT]
	TEST(NE,DIRFF)		; Entering directory?
	 ERRLJF GJFX8		; Yes, syntax error
	TEST(NN,DIRF)		; Do we have a directory yet?
	PUSHJ P,DEFDIR		; No. default it
	TEST(ZE,STARF)
	JRST   [TEST(NN,ASTAF,OSTRF)   ; User typed wild card - allowed?
		 ERRLJF GJFX31         ; No
		JRST STRNAM]	       ; OK, handle it
	PUSHJ P,ENDSTR		; Terminate string, get lookup pointer
	PUSHJ P,NAMLKX		; Look up name without recognition
	JRST ERRDO		; No such file name
	JRST ERRDO
	PUSHJ P,ENDTMP		; Truncate temp block
ENDNA1:	HRLM A,FILNEN(JFN)	; Save as file name
	OKINT
	TEST(O,NAMTF)
	TEST(O,EXTFF)
	JRST SETTMP		; Reset temp block and return

STRNAM:	TEST(O,NAMSF,STEPF)
	PUSHJ P,ENDTMP		; Trim FILTMP
	HRRM A,FILDNW(JFN)	; And save it
	OKINT
	PUSHJ P,SETTMP		; Get another temp for 1st match
	SETZ A,
	PUSHJ P,NAMLKX
	 JRST ERRDO
	 JRST ERRDO
STRNA1:	HRRZ A,FILTMP(JFN)
	NOINT
	HLLZS FILTMP(JFN)
	JRST ENDNA1

; Semicolon (or period ifname but no extension yet)
; Control comes here when a semicolon appears in the input
; Input preceding the semicolon may be:
; 1. a file name if no name has yet been input
; 2. an extension if a name has been input, but no extension
; 3. a protection if neither 1 or 2, and the field was started with p
; 4. a version number if neither 1,2, or 3 and input was numeric
; 5. an account number/string if field was preceded by an a
; Exits with tmpptr reset to null, and keyff=1, numff=1,

ENDEXT:	TEST(NN,NAMF)		; Do we have a name yet?
	PUSHJ P,ENDNAM		; No. take input string as name
	TEST(OE,EXTF)		; Do we have an extension yet?
	JRST ENDEX1		; Yes
	TEST(ZE,STARF)
	JRST   [TEST(NN,ASTAF,OSTRF)   ; User typed wild card - allowed?
		 ERRLJF GJFX31	       ; No
		JRST STREXT]	       ; OK, handle it
	PUSHJ P,ENDSTR		; No, terminate, get lookup pointer
	PUSHJ P,EXTLKX		; Lookup extension without recognition
	JRST ERRDO		; No extension
	JRST ERRDO
	PUSHJ P,ENDTMP		; Truncate temp block
ENDEX6:	HRRM A,FILNEN(JFN)	; Store as file extension
	OKINT
	TEST(O,EXTTF)		; Remember that extension was typed in
	TEST(Z,EXTFF)
	TEST(Z,KEYFF)		; Assume looking for version
	TEST(NN,NUMFF)		; Come here with period (from ENDNAM)?
ENDEX0:	TEST(O,KEYFF)		; No, looking for key letters OK
	TEST(O,NUMFF)		; Also looking for numbers
	TEST(Z,OCTF)
	JRST SETTMP		; Reset temp block and return

ENDEX1:	TEST(ZE,TSFF)		; Were we collecting ;T/;S
	 JRST	[MOVE B,FILCNT(JFN)	; Yes, no other chars allowed here
		 CAIE B,MAXLC
		  ERRLJF GJFX10
		 TEST(NE,STARF)		; Or stars
		  ERRLJF GJFX31
		 JRST ENDEX0]	; OK, carry on
	TEST(ZN,PRTFF)		; Were we collecting a protection
	JRST ENDEX2		; No
	TEST(NE,STARF)		; Any stars input?
	 ERRLJF GJFX31		; Illegal
	SKIPL NUM		; Negative numbers are illegal
	TEST(NN,NUMFF)		; Must be number for now
	ERRLJF GJFX14		; Illegal protection
	TLO NUM,500000
	MOVEM NUM,FILPRT(JFN)
	TEST(O,PRTF,PRTTF)	; Have a protection and it was typed
	JRST ENDEX0

STREXT:	PUSHJ P,ENDTMP		; Trim FILTMP
	HRLM A,FILEXW(JFN)	; And save it
	OKINT
	PUSHJ P,SETTMP		; Get another temp for 1st match
STREX0:	TEST(O,EXTSF,STEPF)
	SETZ A,
	PUSHJ P,EXTLKX
	JRST ERRDO
	JRST ERRDO
	HRRZ A,FILTMP(JFN)
	NOINT
	HLLZS FILTMP(JFN)
	JRST ENDEX6

ENDEX2:	TEST(ZN,ACTFF)		; Were we collecting an account
	JRST ENDEX5		; No
	TEST(NE,STARF)		; Any stars entered?
	 ERRLJF GJFX31		; That's a no-no
	SKIPL NUM		; Positive number and
	TEST(NN,NUMFF)		; Was a number typed?
	JRST ENDEX3		; No
	TLO NUM,500000
	MOVEM NUM,FILACT(JFN)	; Yes, save its negative
	JRST ENDEX4

ENDEX3:	HRRO A,CAPENB
	TRNN A,WHEEL!OPR
	MOVE A,MODES
	TLNN A,(1B1)
	ERRLJF(GJFX30)
	PUSHJ P,ENDSTR		; Account is a string
	PUSHJ P,ENDTMP
	MOVEM A,FILACT(JFN)	; Save positive account block pointer
	OKINT
ENDEX4:	TEST(O,ACTF,ACTTF)
	JRST ENDEX0

ENDEX5:	TEST(NN,NUMFF)		; Was a number input?
	ERRLJF GJFX10
	TEST(NE,VERF)		; And do we not yet have a version?
	ERRLJF GJFX11		; No. syntax error
	TEST(ZE,STARF)
	JRST   [MOVE C,FILCNT(JFN)	; If * typed, must be only one
		CAIGE C,MAXLC-1
	 	 ERRLJF GJFX31		; No
		JRST STRVER]		; OK, handle it
	SKIPN A,NUM
	TEST(O,RVERF)
	CAMN A,MINUS1
	TEST(O,HVERF)
	CAMN A,[-2]
	TEST(O,LVERF)
	CAMN A,[-3]
	JRST STRVER
ENDEX7:	PUSHJ P,GTVER		; Go find an accessible version
	 ERRLJF(GJFX20)		; Oops
	JRST ENDEX0		; Got one, process next field

STRVER:	TEST(NN,ASTAF,OSTRF)	; User typed wild card - allowed?
	 ERRLJF GJFX31		; No
	TEST(NN,NNAMF,NVERF)	; No stars for no name/ver devices
	TEST(O,VERSF,STEPF)	; Note * version
	SETZ A,			; And find first example
	JRST ENDEX7


; Default device
; Call:	PUSHJ P,DEFDEV
; Return
;	+1	; Always
; Gets default device string from user or "dsk"
; And stores as the device for the file given in jfn
; Clobbers a,b,c,d

DEFDEV:	TLNN E,777777		; No defaults if short form
	XCTUU [SKIPN A,2(E)]	; Get user's default pointer
	JRST DEFDV1		; None specified, use dsk
	PUSHJ P,REDFLT		; Copy the default string
	TEST(ZE,DFSTF)
	JRST [	MOVEI A,GJFX31
		JRST ERRDO]
	PUSHJ P,DEVLUK		; Lookup device
	ERRLJF()		; None such
	MOVEM DEV,FILDEV(JFN)
	NOINT
	HLRZ A,FILTMP(JFN)
	HRRZS FILTMP(JFN)
	HRLM A,FILDDN(JFN)
	OKINT
	MOVE B,1(A)			; Get the device string
	CAME B,[ASCIZ /DSK/]		; Is it disk?
	 JRST   [RTPFLG(DEVRF)		; Set non-std retype flag
		 TEST(NE,NREC)		; Recognition allowed?
		  JRST .+1		; No, don't try to type anything
		 MOVE C,FILCNT(JFN)  	; Any other input now?
		 CAIL C,MAXLC
		 TEST(NE,NAMF,DIRF)  	; Or do we have a name or directory?
		 JRST .+1	     	; Yes, can't print non-std device
		 HRRZ B,FILEXW(JFN)  	; All clear, turn off non-std flag
		 MOVSI C,DEVRF
		 ANDCAM C,BLKFG(B)
		 HLRZ B,FILDDN(JFN)  	; Print the device now
		 PUSHJ P,TSTRB
		 CHOUT(":")
		 HLRZ A,FILDDN(JFN)  	; And to the retype buffer
		 PUSHJ P,RTSTRB
		 CHRTP(":")
		 JRST .+1]
	TEST(O,DEVF)
	POPJ P,

DEFDV1:	MOVEI B,2		; Need two words
	NOINT
	PUSHJ P,ASGJFR		; Of job storage
	ERRLJF GJFX22		; No space available
	HRLM A,FILDDN(JFN)	; The block is for the device name
	OKINT
	MOVE B,[ASCIZ /DSK/]
	MOVEM B,1(A)		; The device is "dsk"
	PUSHJ P,DEVLUK
	ERRLJF()		; Dsk should always exist
	MOVEM DEV,FILDEV(JFN)
	TEST(O,DEVF)
	POPJ P,

; Default directory
; Call:	JFN
;	PUSHJ P,DEFDIR
; Returns
;	+1	; If successful
; Does not return if unsuccesful
; Clobbers a,b,c,d

DEFDIR:	TEST(NN,DEVF)
	PUSHJ P,DEFDEV
	TLNN E,777777		; No default if short form
	XCTUU [SKIPN A,3(E)]	; Get default pointer
	JRST DEFDI1		; None specified
	PUSHJ P,REDFLT		; Copy default string
	TEST(ZE,DFSTF)
	JRST DEFDI3		; Wild card
	PUSHJ P,DIRLKX		; Look it up
	JFCL
	ERRLJF GJFX17		; None such
DEFDI0:	HRRM A,FILDDN(JFN)
	TEST(O,DIRF)
	PUSHJ P,RELTMP		; Release temporary store
	HRRZ A,FILDDN(JFN)	; Get the specified directory number
	move b,forkx		; b _ conn dir,,log dir
	skipge b,fkdir(b)
	 move b,fkdir(b)	; Wasn't top fork in group
	hlrz c,b		; c _ conn dir
	caie a,0(b)		; Is the default the login dir
	cain a,0(c)		; or the conn dir?
	 POPJ P,		; Yes, don't try to type it
	RTPFLG(DIRRF)		; No, set non-std retype flag
	TEST(NE,NREC)		; Recognition allowed?
	 POPJ P,		; No, don't try typing the directory
	MOVE C,FILCNT(JFN)  	; Any other input now?
	CAIL C,MAXLC
	TEST(NE,NAMF)		; Or do we have a name already?
	POPJ P,			; Yes, can't print non-std directory
	HRRZ B,FILEXW(JFN)	; OK, turn off non-std flag
	MOVSI C,DIRRF
	ANDCAM C,BLKFG(B)
	CHOUT("<")		; And print it now
	CHRTP("<")		; And in the retype buffer
	TEST(NE,DIRSF)		; Wild card?
	 JRST   [HLRZ B,FILDNW(JFN)   ; Yes print it
		 PUSHJ P,TSTRB
		 HLRZ A,FILDNW(JFN)
		 PUSHJ P,RTSTRB
		 JRST DEFDI2]	; And finish it
DEFDI4:	PUSHJ P,GDNAME		; No wild card, get the dir name string
	 JRST DEFDI2		; Couldn't find it - shouldn't happen
	HLRZ B,FILTMP(JFN)	; Print it
	PUSHJ P,TSTRB
	HLRZ A,FILTMP(JFN)	; And to retype buffer
	PUSHJ P,RTSTRB
	PUSHJ P,RELTMP		; Now release temp temp block
DEFDI2:	CHOUT(">")		; Finish punctuation
	CHRTP(">")
	POPJ P,

DEFDI1:	move a,forkx		; Install the connected dir number
	skipge a,fkdir(a)
	 move a,fkdir(a)	; Wasn't top fork in group
	hlrzs a			; a _ conn dir
	HRRM A,FILDDN(JFN)
	TEST(O,DIRF)
	TEST(NN,NREC)		; Recognition suppressed?
	TEST(ZN,DIRFF)		; or directory not being entered?
	 POPJ P,		; Just return
	JRST DEFDI4		; OK, finish printing it

DEFDI3:	TEST(O,DIRSF,STEPF)	; Wild card, step for first match
	RTPFLG(DIRRF)		; Non-std, force retype if asked
	NOINT
	HLRZ A,FILTMP(JFN)	; Save the wild card string
	HRLM A,FILDNW(JFN)
	HRRZS FILTMP(JFN)
	OKINT
	HRRZ A,DLUKD(DEV)	; Multi dir device?
	CAIE A,MDDDIR
	 ERRLJF GJFX17		; Nope
	MOVEI A,0		; First try
	PUSHJ P,@DLUKD(DEV)	; go find the first match
	 JFCL
	 ERRLJF GJFX17		; None there
	PUSHJ P,USTDIR		; Got it, release dir
	TEST(Z,STEPF)		; No more stepping for now
	JRST DEFDI0		; Go save it


; Default name
; Call:	JFN, ETC.
;	PUSHJ P,DEFNAM
; Return
;	+1	; No default specified
;	+2	; If successful, the name specified is set as filnam
; Does not return if users default does not exist
; Clobbers a,b,c,d

DEFNAM:	TEST(NN,DIRF)
	PUSHJ P,DEFDIR
	TLNN E,777777		; No default for short form
	XCTUU [SKIPN A,4(E)]	; Get user's default pointer
	POPJ P,			; None specified
	PUSHJ P,REDFLT		; Read default string
	TEST(ZE,DFSTF)
	JRST DFSTRN
	PUSHJ P,NAMLKX		; Lookup name
	JRST [	TEST(NE,NNAMF)
		POPJ P,
		JRST ERRDO]
	JRST ERRDO
	NOINT
	HLRZ B,FILTMP(JFN)
	HRRZS FILTMP(JFN)
	HRLM B,FILNEN(JFN)
	OKINT
	TEST(O,NAMF,NAMTF)
	AOS (P)
	TEST(NN,NREC)
	JRST   [HLRZ A,FILNEN(JFN)	; Add default name to retype buffer
		PUSHJ P,RTSTRB
		HLRZ B,FILNEN(JFN)	; And to output JFN
		PUSHJ P,TSTRB
		JRST .+1]
	POPJ P,

DFSTRN:	TEST(O,NAMSF,STEPF)
	NOINT
	HLRZ A,FILTMP(JFN)	; Wild card, save it
	HRRM A,FILDNW(JFN)
	HRRZS FILTMP(JFN)	; Show it's gone
	OKINT
	PUSHJ P,SETTMP		; Should be free, but make sure
	SETZ A,
	PUSHJ P,NAMLKX
	 JRST [	TEST(NE,NNAMF)
		 POPJ P,
		JRST ERRDO]
	 JRST ERRDO
	PUSHJ P,STRNA1
	TEST(Z,EXTFF)
	TEST(O,NAMF,NAMTF)
	TEST(NN,NREC)
	JRST   [HRRZ A,FILDNW(JFN)   ; Add wild card str to retype
		PUSHJ P,RTSTRB
		HRRZ B,FILDNW(JFN)   ; And to user output
		PUSHJ P,TSTRB
		JRST SKPRET]
	JRST SKPRET

; Default extension
; Call:	JFN, ETC.
;	PUSHJ P,DEFEXT
; Return
;	+1	; User default does not exist
;	+2	; Hunky dory, the string specified by the user becomes
;		; The extension

DEFEXT:	TLNN E,777777		; No default if short form
	XCTUU [SKIPN A,5(E)]	; Get user's default pointer
	POPJ P,
	TEST(NE,NNAMF)
	POPJ P,
	PUSHJ P,REDFLT		; Copy default string
	TEST(ZE,DFSTF)
	JRST DFSTRE
	PUSHJ P,EXTLKX		; Look it up
	POPJ P,
	POPJ P,			; None such
	NOINT
	HLRZ B,FILTMP(JFN)
	HRRZS FILTMP(JFN)
	HRRM B,FILNEN(JFN)
	OKINT
	TEST(O,EXTF,EXTTF)
	AOS (P)
	TEST(NN,NREC)
	TEST(NE,NNAMF)
	POPJ P,
	TEST(ZN,EXTFF)		; Entering extension?
	 JRST   [CHRTP <".">	; Not yet, have to add "."
		 CHOUT <".">
		 JRST .+1]
	HRRZ A,FILNEN(JFN)	; Then add the default extension
	PUSHJ P,RTSTRB
	HRRZ B,FILNEN(JFN)
	PUSHJ P,TSTRB
	TEST(NE,NVERF)
	POPJ P,
	CHRTP <";">
	CHOUT <";">
	JRST ENDEX0

DFSTRE:	TEST(ON,EXTFF)
	TEST(NE,NREC)
	JRST DFSTE1
	TEST(NN,NNAMF)
	JRST   [CHOUT <".">	; Add a "."
		CHRTP <".">
		JRST .+1]
DFSTE1:	NOINT
	HLRZ A,FILTMP(JFN)	; Wild card, save it
	HRLM A,FILEXW(JFN)
	HRRZS FILTMP(JFN)	; Show it's gone
	OKINT
	PUSHJ P,SETTMP		; Should be free, but make sure
	PUSHJ P,STREX0		; Go find an example
	TEST(O,EXTF,EXTTF)	; Show we found one
	TEST(NE,NREC)
	 JRST SKPRET
	HLRZ B,FILEXW(JFN)	; Add wild card str to user output
	PUSHJ P,TSTRB
	HLRZ A,FILEXW(JFN)	; And to the retype buffer
	PUSHJ P,RTSTRB
	TEST(NE,NVERF)
	 JRST SKPRET
	CHOUT <";">
	CHRTP <";">
	JRST SKPRET

; Default version
; Call:	JFN ETC.
;	PUSHJ P,DEFVER
; Return
;	+1	; Unless error
; Sets the file version number to the default specified by user
; Clobbers a,b,c,d

DEFVER:	MOVEI A,0
	TEST(NE,NVERF,NNAMF)
	POPJ P,
	XCTUU [HRRE A,0(E)]	; Get default version
	SKIPN A
	TEST(NN,OUTPF)
	JRST .+2
	SOS A			; 0 default becomes -1 for output
	TEST(NN,SCRF)		; Scratch file specified?
	TEST(NN,TMPFF)		; Or not temp?
	 JRST DEFVR1		; Yes, handle version as usual
	SKIPG A			; No, temp file.  Specific version?
	CAMGE A,MINUS1		; Or most recent/*?
	 JRST DEFVR1		; Yes, handle normally
	PUSH P,A		; Save current version spec
	MOVE A,JOBNO		; Try for 100000+job number first
	ADDI A,^D100000
	PUSHJ P,GTVER		; Go find it
	 JRST	[POP P,A	; Bad luck - so try the earlier one
		 JRST DEFVR1]
	SUB P,[1,,1]		; Clear the fall back version
	JRST DEFVR2		; Go see about printing it

DEFVR1:	CAMN A,[-3]
	JRST DFSTRV
	CAMN A,[-2]
	TEST(O,LVERF)
	CAMN A,MINUS1
	TEST(O,HVERF)
	SKIPN A
	TEST(O,RVERF)
	PUSHJ P,GTVER		; Go find a version with acceptable access
	 ERRLJF(GJFX20)		; Bad news, couldn't find one
DEFVR2:	PUSH P,B		; Save the FDB ctl bits
	MOVE B,A		; Output the version if necessary
	TEST(NE,NREC)		; Recognition?
	 JRST DEFVR3		; No, finish doing version field
	PUSHJ P,DNOUT		; Yes, type version number
	HRRZ B,FILVER(JFN)	; Add version number to retype buffer
	MOVEI C,^D10
	PUSHJ P,RTNOUT

DEFVR3:	POP P,A			; Recover FDB ctl bits
	TLNN A,FDBTMP		; Temp file already?
	TEST(NE,TMPFF)		; Or specified?
	 SKIPA
	JRST DEFVR5		; No, wrap things up
	TEST(NE,NREC)		; Recognition suppressed?
	 JRST DEFVR4		; Yes, make sure bits are set
	HRRZ B,FILVER(JFN)	; Version in temp range?
	CAIGE B,^D100000
	 JRST [TEST(NE,SCRTF)	; No, ;s already typed?
		JRST DEFVR4
	       TMSG </;S/>	; No, type it
	       RTPMSG </;S/>
	       JRST DEFVR4]
	TEST(NE,TMPTF)		; Temp file, ;t already typed?
	 JRST DEFVR4		; Yes
	TMSG </;T/>		; No, type it
	RTPMSG </;T/>
DEFVR4:	PUSHJ P,TCH1		; Yes, set up bits
DEFVR5: TEST(O,TSFF)		; Make sure next ; is ignored
	JRST ENDEX0

DFSTRV:	PUSHJ P,STRVER
	TEST(O,VERTF,VERF)
	TEST(NN,NREC)
	JRST   [PUSHJ P,TYSTR	; Output stars
		CHRTP("*")
		JRST .+1]
	POPJ P,

; Default account
; Call:	JFN ETC.
;	PUSHJ P,DEFACT
; Returns
;	+1	; Always
; Sets filact to that specified by program
; Clobbers a,b,c,d

DEFACT:	TEST(NE,NVERF,NNAMF)
	POPJ P,
	TLNN E,777777		; No default if short form
	XCTUU [SKIPN A,7(E)]	; Get default account
	POPJ P,			; Nono specified
	TLNN A,777777		; Lh = 0?
	HRLI A,440700		; Yes, set up 7 bit bytes
	CAMG A,[577777777777]	; String pointer?
	CAMGE A,[500000000000]
	JRST DEFAC2		; Yes
	MOVEM A,FILACT(JFN)	; No. numeric
	JRST DEFAC3

DEFAC2:	MOVE B,MODES
	HRR B,CAPENB		; STRING OK IF WHEEL/OPER
	TDNN B,[1B1!WHEEL!OPR]
	POPJ P,			; STRING NOT ALLOWED
	PUSHJ P,REDFLT		; Copy string to temp block
	NOINT
	HLRZ A,FILTMP(JFN)
	HRRZS FILTMP(JFN)
	MOVEM A,FILACT(JFN)
	OKINT
DEFAC3:	TEST(O,ACTF)
	POPJ P,

; Default protection
; Call:	JFN ETC.
;	PUSHJ P,DEFPRT
; Return
;	+1	; unless error
; Sets the file protection to default specified by user or directory
; Clobbers a,b,c,d

DEFPRT:	TEST(NE,NVERF,NNAMF)
	POPJ P,
	TLNN E,777777		; No default if short form
	XCTUU [SKIPN A,6(E)]	; Get the default protection from user
	POPJ P,
	CAMG A,[577777777777]	; Must be numeric
	CAMGE A,[500000000000]
	ERRLJF GJFX14		; Otherwise error
	MOVEM A,FILPRT(JFN)
	TEST(O,PRTF)
	POPJ P,

; Copy default string
; Call:	A	; A default string pointer
;	PUSHJ P,REDFLT
; Returns
;	+1	; In a, a lookup pointer
; Copies the default string into a block addressed by lh(filtmp(jfn))
; Clobbers a,b,c,d

REDFLT:	PUSH P,A
	HLRZ A,FILTMP(JFN)
	JUMPN A,REDFL0
	MOVEI B,MAXLW+1
	NOINT
	PUSHJ P,ASGJFR
	ERRLJF GJFX22		; Insufficient space
	HRLM A,FILTMP(JFN)
	OKINT
REDFL0:	HRLI A,(<POINT 7,0>)
	AOS C,A
	POP P,A
	MOVEI D,MAXLC+1
	MOVEI B,0		; Null byte if next instruction jumps
	TEST(Z,DFSTF)
	TLC A,-1		; Implicit byte pointer?
	TLCN A,-1
	 HRLI A,440700		; Yes, make it real
REDFL1:	XCTBU [ILDB B,A]
	ANDI B,177
	CAIL B,"a"
	CAILE B,"z"
	CAIA
	SUBI B,"a"-"A"		;GET RID OF LOWER CASE LETTERS
	PUSH P,C
	PUSH P,B
	IDIVI B,^D36/CCSIZE
	LDB C,CPTAB(B+1)
	POP P,B
	CAIN C,16		; Character quote?
	 JRST REDFL3
	CAIN C,20
	JRST   [TEST(O,DFSTF)
		TEST(NN,ASTAF,OSTRF)   ; Wild card - allowed?
		 ERRLJF GJFX31	       ; No
		JRST REDFL4]
	CAIL C,21
	CAILE C,24
	CAIN C,30
	JRST REDFL4
	CAIE C,32		; S?
	CAIN C,0		; or UC letter
	 JRST REDFL4		; Yes, save it
	MOVEI B,0
REDFL4:	POP P,C

REDFL2:	SOSGE D
	ERRLJF GJFX5
	IDPB B,C
	JUMPN B,REDFL1		; If not end, do another

	TEST(ZE,CNTVF)		; Any chars quoted?
	TEST(NE,DFSTF)		; Any wild cards?
	 JRST REDFL6		; Leave string as is
	HLRZ A,FILTMP(JFN)	; No, squeeze out any ^V's
	AOS A
	HRLI A,440700
	MOVE C,A		; A = source, C = destination
REDFL5:	ILDB B,A		; Copy a char
	CAIN B,<"V"-100>	; Unless it's a ^V
	 JRST REDFL5
	IDPB B,C
	JUMPN B,REDFL5		; And quit after a 0
REDFL6:	HLRZ A,FILTMP(JFN)
	MOVE B,C
	PUSHJ P,TRMBLK		; Trim the block and return excess
	HLRZ A,FILTMP(JFN)
	MOVN B,(A)
	HRLI A,2(B)
	POPJ P,

REDFL3:	POP P,C
	TEST(O,CNTVF)		; Mark ^V active
	SOSGE D			; Append ^V for now
	 ERRLJF GJFX5
	IDPB B,C
	XCTBU [ILDB B,A]
	JRST REDFL2


; New character delete and field delete stuff for backspacing, etc.
; Dispatched from the character table

DLCHR:	PUSHJ P,DECBUF		; Go decrement the buffers 1 char
	 JRST RDING		; Nothing left, break or ring him
	SKIPL A			; Was this char quoted?
	 JRST   [HRRZ B,A	; No, check for wild card
		 CAIE B,"*"
		 CAIN B,"%"
		 TEST(O,RSCNF)	; Had one, better rescan the input
		 JRST .+1]
	TLZE A,FILTDN		; FILTMP empty?
	 TEST(O,RSCNF)		; Yes, better rescan the input
	PUSH P,A		; Save the deleted char
	XCTUU [HRRZ A,1(E)]	; Get user's out JFN if any
	TLNE E,777777
	TLNE E,2
	CAIN A,377777		; JFN, was it NULL?
	 JRST DLCHR1		; Yes, finish up
	DELCH			; Do display delete
	 JRST DLCHR0		; Not a TTY
	 JFCL			; Display already at 0
	 JRST DLCHR1		; Display char wiped out
DLCHR0:	CHOUT ("\")		; Old standby notation
	HRRZ B,0(P)		; And the char itself
	PUSHJ P,OUTCH
	SKIPG 0(P)		; ^V there?
	 JRST   [TMSG<"^V">	; Let him know it was quoted
		 JRST .+1]

DLCHR1:	SUB P,[1,,1]		; Reset stack
	TEST(NN,RSCNF)		; Rescan required?
	 POPJ P,		; No, return straight away
	jrst rescan		; Yes, go do it


; This routine deletes what exists of the current field.  It then
; forces a rescan of the input to reestablish the right state.

DELFLD:	PUSHJ P,CNTFLD		; Count the chars to delete this field
	JUMPE D,RDING		; If none there, break or ding him
	XCTUU [HRRZ A,1(E)]	; Get his output JFN, if any
	TLNE E,777777
	TLNE E,2
	CAIN A,377777		; JFN, is it NULL?
	 JRST RESCAN		; Yes, just go do the rescan
	PUSH P,A		; Save the JFN for now
	DVCHR			; What kind of device is it?
	POP P,A
	HLRZS B
	ANDI B,777		; Split out device type
	CAIE B,TTYDV		; TTY?
	 JRST DELFL3		; No, do the old type
DELFL2:	DELCH			; TTY, try wiping screen
	 JRST DELFL3		; Not a TTY? - shouldn't happen!
	 JFCL			; Display already at 0
	 JRST   [SOJG D,DELFL2	; OK, do the rest
		 JRST RESCAN]	; Last one, go rescan the input

DELFL3:	CHOUT("_")		; Old style field delete
	JRST RESCAN		; Now rescan


; Delete everything

DELALL:	MOVE B,[BYTE (2)0,0,0,0,0,0,0,0,0,0,2,0,0,2,0,0,0,0]
	MOVE C,[BYTE (2)0,0,0,0,0,0,0,0,0,0,0,0,0,2]
	PUSHJ P,SFCC
	PUSHJ P,DECBUF		; See if anything left
	 JRST RDING		; No, break or ding
	TMSG </___/>
	PUSHJ P,SFCC0
	NOINT
	PUSHJ P,RELJFN		; Release jfn (to clear free storage)
	PUSHJ P,ASGJFN		; And reassign
	 ERR(GJFX3)		; Should not happen, but in case
	OKINT
	XCTUU [HLLZ F,0(E)]
	MOVEI F1,0
	PUSHJ P,SETRTP		; Set up a new retype buffer
	PUSHJ P,SETTMP		; And a temp buffer
	JRST RETYPE		; Now go retype - nothing really but
				; the user may have a prompt


; Recognize current field
; Called from gtjfn loop
; Decides which field was being input, and then attempts to recognize it

RECFLD:	TLNE F1,DIRSF!NAMSF!EXTSF!VERSF!STARF
	JRST DING		; Cannot recognize after *
	TEST(NE,DIRFF)		; Find which field is being input
	JRST RECDIR		; Directory name is
	TEST(NE,EXTFF)
	JRST RECEX0		; Extension is
	TEST(NN,NAMF)
	JRST RECNA0		; Recognize name
	MOVE C,FILCNT(JFN)
	CAIE C,MAXLC
	JRST RECFL1		; Some thing typed, treat like cont-f
	TEST(NE,VERF)
	JRST DING		; Can recognize no more
	AOS 0(P)		; Make return +2 (DEFVER bombs if error)
	JRST DEFVER		; Default version

RECFL0:	TEST(NE,DIRFF)
	JRST RECDIR
	TEST(NE,EXTFF)
	JRST RECEXT
	TEST(NN,NAMF)
	JRST RECNAM
RECFL1:	MOVEI B,";"
	TEST(NN,NREC)
	JRST   [PUSHJ P,OUTCH
		CHRTP <";">
		JRST .+1]
	AOS (P)
	JRST ENDEXT

; Recognize directory name
; Call:	RH(FILTMP(JFN))	; Pointer to string block to recognize
;	FILOPT(JFN)	; Pointer to last character in string
; Flags norec, devf, dirf,dirff,dirtf are updated or used
;	PUSHJ P,RECDIR
; Return
;	+1	; Ambiguous
;	+2	; Ok
; Does not return if directory could not exist
; Clobbers most everything

RECDIR:	TEST(NN,DEVF)
	PUSHJ P,DEFDEV		; Default device first
	PUSHJ P,ENDSTR		; Terminate string, get lookup pointer
	PUSH P,FILOPT(JFN)	; Save filopt(jfn) for typing out tail
	PUSHJ P,DIRLUK		; Lookup directory name get number
	ERRLJF GJFX17		; No such directory
	JRST [	pop p,a		; Recover initial FILOPT
		pushj p,rectyp	; Recognize what we can
		PUSHJ P,DING
		POPJ P,]
	HRRM A,FILDDN(JFN)	; Store directory number
	pop p,a			; Recover initial FILOPT
	pushj p,rectyp		; Type recognized part of string
	CHRTP(">")		; Add right bracket to retype buffer
	CHOUT(">")		; and primary
	TEST(O,DIRF,DIRTF)
	TEST(Z,DIRFF)
	AOS (P)
	JRST SETTMP		; Reset temp block and return

; Recognize extension
; This routine operates in the same way as recdir described above

RECEXT:	PUSHJ P,RECEXX
	JRST ERRDO
	JRST DING
	JRST SKPRET

RECEXX:	PUSHJ P,ENDSTR		; Terminate string, get lookup pointer
	PUSH P,FILOPT(JFN)	; Save filopt(jfn) for typing out tail
	PUSHJ P,EXTLUK		; Lookup extension
	jrst [	sub p,[1,,1]	; No such extension, clear stack
		popj p,]	; And error return
	JRST [  pop p,a		; Recover initial FILOPT
		pushj p,rectyp	; Recognize what we can
		JRST SKPRET]	; Ambiguous
	PUSHJ P,ENDTMP		; Truncate temp string get pointer
	HRRM A,FILNEN(JFN)	; Store as extension
	OKINT
	TEST(O,EXTF,EXTTF)
	TEST(Z,EXTFF)
	pop p,a			; Recover initial FILOPT
	AOS (P)
	AOS (P)
	TEST(NN,NNAMF)
	TEST(NE,NREC)		; Were we performing recognition?
	JRST SETTMP		; No. done
	pushj p,rectyp
	TEST(NE,NVERF)
	JRST SETTMP
	CHOUT <";">		; And semicolon
	CHRTP <";">
	TEST(O,KEYFF,NUMFF)	; And act like the user did it
	JRST SETTMP		; Reset temp block and return

RECEX0:	PUSHJ P,RECEXX
	 JFCL
	 SKIPA
	 JRST SKPRET
	MOVE C,FILCNT(JFN)
	CAIN C,MAXLC
	PUSHJ P,DEFEXT
	JRST DING
	JRST SKPRET

; Recognize name
; This routine operates in the same way as recdir and recext above

RECNA0:	PUSHJ P,RECNA1
	JRST [	MOVE C,FILCNT(JFN)
		CAIN C,MAXLC
		PUSHJ P,DEFNAM
		JRST DING
		JRST .+1]
	TEST(NE,NNAMF)
	JRST SKPRET
	CHOUT "."
	CHRTP <".">
	TEST(O,EXTFF)
	JRST SKPRET

RECNAM:	PUSHJ P,RECNA1
	JRST DING
	JRST SKPRET

RECNA1:	TEST(NN,DIRF)
	PUSHJ P,DEFDIR		; Default directory
	PUSHJ P,ENDSTR		; Terminate string, get lookup pointer
	PUSH P,FILOPT(JFN)	; Save filopt(jfn) for typing tail
	PUSHJ P,NAMLUK		; Lookup name in directory
	JRST ERRDO
	JRST [	pop p,a		; Recover initial FILOPT
		pushj p,rectyp	;Recognize what we can
		POPJ P,]	; Ambiguous
	PUSHJ P,ENDTMP		; Truncate temp block, and get pointer
	HRLM A,FILNEN(JFN)	; To put in file name
	OKINT
	TEST(O,NAMF,NAMTF)
	pop p,a			; Recover initial FILOPT
	AOS (P)
	TEST(NN,NNAMF)
	TEST(NE,NREC)
	JRST SETTMP		; Setup new temp, and return
	pushj p,rectyp
	JRST SETTMP

; Routine to add recognized string to user's output
; Entry:   A = starting FILOPT
;	   FILOPT = new end of string
; Call:    pushj p,rectyp
; Return:  +1 always, clears old FILOPT from stack

rectyp:	push p,a		; Save initial FILOPT
	pushj p,rtstr		; Add rest of string to retype buffer
	pop p,b			; Old FILOPT again
	pushj p,tstr		; Output remainder of string
	popj p,

; Retype input so far

RETYPE:	MOVE B,[BYTE (2)0,0,0,0,0,0,0,0,0,0,2,0,0,2,0,0,0,0]
	MOVE C,[BYTE (2)0,0,0,0,0,0,0,0,0,0,0,0,0,2]
	PUSHJ P,SFCC
	TMSG </
/>
	PUSHJ P,SFCC0
	XCTUU [HRRZ A,1(E)]	; Get user's output JFN (or str ptr)
	TLNE E,777777		; Long or short?
	TLNE E,2		; short, AC 2 = jfn's?
	CAIN A,377777		; Real output jfn - is it null?
	 POPJ P,		; Str ptr or null, return

; Output jfn is in AC 1.  Check if user has a prompt to add

	HRRZ B,FILEXW(JFN)	; Get ptr to retype buffer
	MOVE C,BLKFG(B)		; And the flags
	TLNN C,USRPR		; User prompt there?
	 JRST RETY0A		; No just retype the file stuff
	XCTUU [MOVE C,PRPTR(E)]		; Get user's byte ptr
	TLC C,777777		; If implicit, make it real
	TLCN C,777777
	 HRLI C,440700
RETY0:	XCTBU [ILDB B,C]	; Get a user's byte
	JUMPE B,RETY0A		; If end of string, exit
	BOUT			; Otherwise let him see it
	JRST RETY0		; And the next one

RETY0A:	HRRZ B,FILEXW(JFN)	; Back to retype buffer
	MOVE C,BLKBP(B)		; Make sure the string ends in 0
	SETZ D,
	IDPB D,C
	MOVEI C,BLKDT(B)	; Now build str ptr to start
	HRLI C,440700
	PUSH P,C		; and save it
	MOVE C,BLKFG(B)		; does he want a literal retype?
	TLNE C,LITRF
	 JRST RETYSO		; Yes, just do it

; Here we have to edit in any non-standard defaults for the Device and
; the Directory since they won't have been typed and type out the rest
; of the name.

	SUB P,[1,,1]		; First reset the stack
	TEST(NE,DEVTF)		; Explicit device typed?
	 JRST RETY0B		; Yes, go print it
	HRRZ B,FILEXW(JFN)	; No, but device may be non-std
	MOVE B,BLKFG(B)		; Get flags
	TLNN B,DEVRF
	 JRST RETY1		; No it's OK, look at directory
RETY0B:	HLRZ B,FILDDN(JFN)	; Non-std, write it
	PUSHJ P,TSTRB
	CHOUT <":">		; And ending ":"

RETY1:	TEST(NE,DIRTF)		; Directory explicitly typed?
	 JRST RETY1B		; Yes, print it
	HRRZ B,FILEXW(JFN)	; No, check non-std flags
	MOVE B,BLKFG(B)
	TLNN B,DIRRF
	 JRST RETY2		; It's standard - forget it
RETY1B:	CHOUT ("<")		; Non-std, print it
	TEST(NE,DIRSF)		; Wild card?
	 JRST   [HLRZ B,FILDNW(JFN)   ; Yes print it
		 PUSHJ P,TSTRB
		 JRST RETY1A]	; And finish it
	PUSHJ P,GDNAME		; Real name - get the string
	 JRST RETY1A		; Error here, shouldn't happen
	HLRZ B,FILTMP(JFN)	; Got it, so print it
	PUSHJ P,TSTRB
	PUSHJ P,RELTMP		; that's done so release the temp temp
RETY1A:	CHOUT (">")		; Finish punctuation

RETY2:	TEST(NE,NAMTF)		; Name typed?
	TEST(NE,NNAMF)		; And device with file names?
	POPJ P,			; No, just quit
	HLRZ B,FILNEN(JFN)	; Assume regular name
	TEST(NE,NAMSF)		; Wild card?
	 HRRZ B,FILDNW(JFN)	; Yes, use that string instead
	PUSHJ P,TSTRB
	CHOUT <".">		; And punctuate
	TEST(NN,EXTTF)		; Extension typed?
	 POPJ P,		; No, quit
	HRRZ B,FILNEN(JFN)	; Yes, assume regular extension
	TEST(NE,EXTSF)		; Wild card?
	 HLRZ B,FILEXW(JFN)	; Yes, use it instead
	PUSHJ P,TSTRB		; Print it

	TEST(NE,VERTF)		; Version typed?
	TEST(NE,NVERF)		; And device with versions, etc.?
	 POPJ P,		; No, quit
	CHOUT <";">
	TEST(NE,VERSF)		; Wild card?
	JRST [	PUSHJ P,TYSTR	; Yes, print *
		JRST RETY2A]
	HRRZ B,FILVER(JFN)	; No, append decimal number
	PUSHJ P,DNOUT
RETY2A:	TEST(NE,TMPTF)		; ;T typed?
	 JRST	[TMSG </;T/>	; Yes, print it
		 JRST RETY4]
	TEST(NE,SCRTF)		; ;S typed?
	 JRST	[TMSG </;S/>	; Yes, print it
		 JRST RETY4]
RETY4:	TEST(NN,PRTTF)		; Protection typed in?
	 JRST RETY3		; No, try account
	TMSG </;P/>
	MOVE B,FILPRT(JFN)
	TLNE B,777777
	JRST [	TLZ B,700000
		PUSHJ P,ONOUT
		JRST RETY3]
	PUSHJ P,TSTRB
RETY3:	TEST(NN,ACTTF)		; Account typed in?
	 POPJ P,		; No, quit
	TMSG </;A/>
	SKIPLE B,FILACT(JFN)
	JRST [	PUSHJ P,TSTRB	; String account, print it
		POPJ P,]
	TLZ B,700000		; Numeric, print it
	PUSHJ P,DNOUT
	POPJ P,			; All done, quit


; Here the rest of the retype buffer is all in order.  Just output it
; as is

RETYSO:	POP P,B			; This is the most recent pointer
	SETZ C,			; Now it's ASCIZ
	SOUT
	POPJ P,			; And wrap it up


TYSTR:	TMSG (/*/)
	POPJ P,

; Terminator seen, finish up

ENDALL:	TEST(O,NREC)		; Suppress recognition
	TEST(NN,STRF)		; NO "ECHO" IF TERMINATOR FROM STRING
	TEST(NE,CFRMF)
	JRST ENDALD
	TEST(NN,PONFF,RTYPF)
	CAIL A,40
	JRST ENDALD
	MOVE B,[BYTE (2)0,0,0,0,0,0,0,0,0,0,2,0,0,2,0,0,0,0]
	MOVE C,[BYTE (2)0,0,0,0,0,0,0,0,0,0,0,0,0,2]
	PUSH P,A
	PUSHJ P,SFCC
	POP P,B
	PUSHJ P,OUTCH
	PUSHJ P,SFCC0
ENDALD: TEST(NE,DIRFF)		; Directory unfinished?
	 ERRLJF GJFX8		; Yes, bad luck
	JRST ENDALZ

RECALL:	TLNE F1,DIRSF!NAMSF!EXTSF!VERSF!STARF
	 TEST(O,NREC)
ENDALZ:	TEST(NN,STARF)		; Star in this field?
	 JRST ENDST1		; No
	TEST(NN,DIRFF)		; Yes, directory being entered?
	 JRST ENDST0		; No
	CHOUT(">")		; Yes, finish off directory field
	CHRTP(">")
	PUSHJ P,ENDDIR		; Look it up
	JRST ENDST1		; OK, now try the name
ENDST0:	PUSHJ P,[TEST(NN,NAMF)
		JRST ENDNAM
		JRST ENDEXT]
ENDST1:	MOVE C,FILCNT(JFN)
	CAIE C,MAXLC		; Is input string null?
	JRST [  TEST(NE,EXTF)	; Extension yet?
		TEST(O,NREC)	; Yes, make sure no more recognition
		PUSHJ P,RECFL0	; No. recognize field first
		JRST GTJF2	; Ambiguous
		JRST .+1]
	TEST(NE,DIRFF)		; Directory being entered - just left bracket
	 PUSHJ P,DEFDIR		; Yes, default it
	TEST(NE,NAMF)		; Do we have a name?
	JRST ENDAL0		; Yes.
	PUSHJ P,DEFNAM		; No, try the default name
	JRST [	PUSHJ P,RECNAM	; No default, try recognizing null
		JRST GTJF2	; Ambiguous
		JRST ENDAL0]	; Ok, found
ENDAL0:	TEST(NE,EXTF)		; After all that, do we have ext?
	JRST ENDAL4		; Yes
	TEST(NN,DIRSF,NAMSF)	; Use extension default if wild card
	TEST(NN,EXTFF)
	PUSHJ P,DEFEXT		; Attempt to default extension
	JRST ENDAL6
ENDAL4:	TEST(NN,VERF)		; Do we have a version?
	PUSHJ P,DEFVER		; No, default it
	TEST(NN,NEWF,NEWVF)
	JRST ENDAL7
	TEST(NN,PRTF)		; Do we have protection?
	PUSHJ P,DEFPRT		; No, default it
	TEST(NN,ACTF)		; Do we have an account?
	PUSHJ P,DEFACT		; No, default it
ENDAL7:	TEST(NE,RTYPF)		; User request retyping name?
	JRST   [HRRZ B,FILEXW(JFN)	; Do full fledged retype now
		MOVSI C,LITRF		; Clear literal flag
		ANDCAM C,BLKFG(B)
		PUSHJ P,RETYPE		; And retype the file name
		JRST .+1]
	TEST(NN,PONFF)		; User request print of old/new file etc
	 JRST [	TEST(NN,CFRMF)	; NO, BUT IS CONFIRMATION WANTED?
		 JRST ENDAL3	; NO, BYPASS THIS
		JRST ENDALC]	; YES, PRING CONFIRM

ENDAL1:	MOVE B,[BYTE (2)0,0,0,0,0,0,0,0,0,0,2,0,0,2,0,0,0,0]
	MOVE C,[BYTE (2)0,0,0,0,0,0,0,0,0,0,0,0,0,2]
	PUSHJ P,SFCC
	HRROI B,[ASCIZ / [Old file]/]
	TEST(NN,NVERF)
	HRROI B,[ASCIZ / [Old version]/]
	TEST(NE,NEWVF)		; Did we generate a new version?
	HRROI B,[ASCIZ / [New version]/]
	TEST(NE,NEWF)		; Did we generate a new file
	HRROI B,[ASCIZ / [New file]/]
	TEST(NN,NNAMF)		; Non-dir devices and
	TLNE F1,DIRSF!NAMSF!EXTSF!VERSF	; any stars get [ok/confirm]
	 JRST .+2
	JRST ENDAL9
	HRROI B,[ASCIZ / [OK]/]
	TEST(NE,CFRMF)
ENDALC:	HRROI B,[ASCIZ / [Confirm]/]
ENDAL9:	PUSH P,B		; Save ptr for now
	MOVE A,B
	HRRZ B,FILEXW(JFN)	; See if he wants this in typescript
	MOVE C,BLKFG(B)
	TRZE C,TPCNF
	 JRST   [MOVEM C,BLKFG(B)  ; Make sure he only gets one copy
		 PUSHJ P,RTSTR
		 JRST .+1]
	POP P,B			; Restore the pointer
	PUSHJ P,TSTR		; Print it
	PUSHJ P,SFCC0
ENDAL3:	XCTUU [HLRZ A,1(E)]
	TLNE E,777777
	TLNE E,2
	CAIN A,377777
	JRST ENDAL2		; No input file
	TEST(NN,CFRMF)
	JRST ENDAL2		; Or no confirmation requested
	RFMOD			; Set to break on everything
	TRZ B,777700
	IORI B,174100
	SFMOD
	MOVE B,[BYTE (2)1,1,1,1,1,1,1,2,1,2,2,2,2,2,1,1,1,0]
	MOVE C,[BYTE (2)0,1,1,1,1,1,0,1,1,1,1,1,1,2]  ; Not ^R
	PUSHJ P,SFCC
	BIN			; Else read confirmation character
	IDIVI B,^D36/CCSIZE
	LDB B,CPTAB(B+1)	; Get character class
	CAIN B,6
	JRST [  RFMOD		; Have to start over, reset mode
		TRZ B,777700	; To break on non-alpha
		IORI B,164100
		SFMOD
		PUSHJ P,DELALL
		JRST GTJF2]
	CAIN B,4
	JRST [	PUSHJ P,RETYPE	; And control-r
		JRST ENDAL3]
	CAIE B,7		; Terminator
	CAIN B,10		; Or alt-mode
	JRST ENDAL2		; Is ok
	ERRLJF GJFX15		; Improper confirmation

ENDAL2:	TEST(NE,NEWF,NEWVF)	; If old file or version, can't change
				; prot, acct, or tempff
	TEST(NE,ASTF)
	 JRST ENDALS
	TEST(NE,PRTF)		; Do we have a protection?
	PUSHJ P,@PLUKD(DEV)	; Insert it into the directory
	TEST(NN,ACTF)		; Do we have an account string?
	 JRST [	TEST(NN,NEWVF,NEWF)	; No, but if new version
		 JRST .+2
		PUSH P,ACCTSR-1	; Save this (LOGBUF+4) - messes EFACT entries
		MOVE A,ACCTSL##	; In case we need this
		MOVEM A,ACCTSR-1; Set it up
		MOVE A,ACCTPT
		CAML A,[500000000000]
		CAMLE A,[577777777777]
		 MOVEI A,ACCTSR-1
		NOINT		; This string block is outside string
				; space.  Must not try to release it.
		MOVEM A,FILACT(JFN)
		PUSHJ P,@ALUKD(DEV)
		SETZM FILACT(JFN)
		OKINT		; OK, cleared the kludge
		POP P,ACCTSR-1	; Restore LOGBUF+4
		JRST .+2]
	PUSHJ P,@ALUKD(DEV)	; Yes, insert it into the directory
	TEST(NN,NEWF,NEWVF)	; IF NOT NEW VERSION OR FILE
	 JRST ENDALS		; SKIP FOLLOWING
	MOVSI B,FDBTMP
	TEST(NE,TMPFF)		; Is this file to be temp?
	PUSHJ P,@SLUKD(DEV)
ENDALS:	tlnn e,777777		; Long call?
	test(nn,lltbf)		; Yes, long table?
	 jrst endalt		; No, move on
	xctuu [move a,extwd(e)]	; Get user's word E+11
	tlz a,fnnam!fnver!fnewf!fnewv   ; Clear the file existence bits
	test(ne,nnamf)		; No name device?
	 tlo a,fnnam		; Yes
	test(ne,nverf)		; No version numbers?
	 tlo a,fnver		; Yes
	test(ne,newf)		; New file name?
	 tlo a,fnewf		; Yes
	test(ne,newvf)		; New version?
	 tlo a,fnewv		; Yes
	xctuu [movem a,extwd(e)]   ; Store the new word in the user table
	pushj p,trmutp		; Terminate user typescript if needed
endalt:	NOINT
	MOVEI A,JSBFRE
	SKIPLE B,FILACT(JFN)
	PUSHJ P,RELFRE		; Release storage used to hold account
	SKIPLE B,FILPRT(JFN)
	PUSHJ P,RELFRE		; And protection
	HRRZ B,FILTMP(JFN)
	SKIPE B
	PUSHJ P,RELFRE		; And temp
	HLRZ B,FILTMP(JFN)
	SKIPE B
	PUSHJ P,RELFRE
	HRRZ B,FILEXW(JFN)	; Retype buffer
	SKIPE B
	PUSHJ P,RELFRE
	SETZM FILTMP(JFN)
	SETZM FILPRT(JFN)
	SETZM FILACT(JFN)
	SETZM FILOPT(JFN)
	SETZM FILCNT(JFN)
	HLLZS FILEXW(JFN)	; Clear retype buffer
	AND STS,[XWD 100,0]	; Retain astf
	IOR STS,FILSTS(JFN)	; Get rest of sts
	TEST(Z,ASGF)		; Clear assign flag
	TEST(O,NAMEF)		; Set name attached flag
	TEST(NE,NACCF)
	TEST(O,FRKF)
	MOVEM STS,FILSTS(JFN)
	PUSHJ P,INFTST
	JRST ENDAL5
	POP P,A
	POP P,B
	SFMOD
	POP P,C
	POP P,B
	SFCOC

ENDAL5:	OKINT
	AOS (P)			; Done, skip return
	LSH JFN,-SJFN		; Shift jfn from index to number
	TLNN F,ASTAF!OSTRF!RLHFF; ARE LEFT HALF FLAGS WANTED?
	 JRST ENDA51		; NO, SKIP THIS
	TEST(NE,PRTTF)		; IF ;P SPECIFIED
	 TEST(O,FXPRT)		; SAY SO
	TEST(NE,ACTTF)		; LIKEWISE FOR ;A
	 TEST(O,FXACT)
	TEST(NE,TMPTF)		; AND ;T
	 TEST(O,FXTMP)
	HLL JFN,F1
	TLZ JFN,STEPF!DFSTF!STARF!EXTXF; CLEAR FLAGS THAT DON'T GET RETURNED
	TEST(NN,IGDLF)
	 TLO JFN,(1B12)
ENDA51:	UMOVEM JFN,1		; Return jfn to user
	JRST MRETN		; And exit.

ENDAL6:	TEST(ON,EXTFF)
	TEST(NE,NREC)
	JRST .+3
	TEST(NN,NNAMF)
	 JRST   [CHOUT (".")	; Add a "."
		 CHRTP (".")
		 JRST .+1]
	PUSHJ P,RECEXX
	JRST [  TLNE F1,DIRSF!NAMSF!EXTSF!STARF
		 ERRLJF GJFX19
		PUSHJ P,DEFEXT
		JRST ERRDO
		JRST ENDAL4]
	JRST [	PUSHJ P,DING
		JRST GTJF2]
	JRST ENDAL4

; Star typed
STAR:	TEST(NE,OSTRF)		; If output stars,
	TEST(O,ASTF)		; Set * bit in sts
	TEST(O,STARF)		; And note this wild card
	 JRST LTR		; Otherwise, add the char to buffers


; Set up temp string block for this jfn
; Call:	JFN IN JFN
;	JSYS SETTMP
; Sets up filopt(jfn) and rh(filtmp(jfn)) and filcnt(jfn)
; Clobbers a,b,c
; Clears num

SETTMP:	HRRZ A,FILTMP(JFN)	; Is block assigned?
	JUMPN A,SETTM1		; Yes, use it
	MOVEI B,MAXLW+1
	NOINT
	PUSHJ P,ASGJFR		; Assign a free storage area in psb
	 JRST   [OKINT		; No room
		 ERRLJF GJFX22]
	HRRM A,FILTMP(JFN)	; Save in tmpptr
	OKINT
SETTM1:	HRLI A,(<POINT 7,0>)
	AOS A
	MOVEM A,FILOPT(JFN)	; Set filopt(jfn)
	MOVEI A,MAXLC
	MOVEM A,FILCNT(JFN)
	MOVEI NUM,0		; Clear number
	TEST(Z,NEGF)
	POPJ P,


; Get character from string of file
; Call:	PUSHJ P,GCH
; Return
;	+1	; No more input
;	+2	; Ok, in a, the character
; Clobbers b

GCH:	TEST(NN,RSCNF)		; Rescanning retype buffer?
	 JRST GCH0		; No
	HRRZ C,FILEXW(JFN)	; Get block ptr
	MOVE B,BLKBP(C)		; And the current byte pointer
	ILDB A,B		; Fetch a char
	JUMPN A, [MOVEM B,BLKBP(C)   ; If not 0, save new ptr
		  SOS BLKCT(C)	     ; And decrement available space
		  JRST SKPRET]
	TEST(Z,RSCNF)		; No more, clear rescan flag
GCH0:	TEST(NN,STRF)		; Does string exist?
	JRST GCH1		; No, get from file
IFN KAFLG!F3FLG,<
	XCTUU [ILDB A,2]	; Get character increment byte ptr
>
IFN KIFLG,<
	XCTUU [MOVE 2,2]	; BYTE POINTER IN MONITOR SPACE
	TLNE 2,37		; NO INDIRECT OR INDEXING
	ERRLJF GJFX33
	XCTUU [ILDB A,2]	; GET THE BYTE
	XCTUU [MOVEM 2,2]	; STORE UPDATED POINTER
>
	JUMPN A,SKPRET		; Return if non-null
	TEST(Z,STRF)		; No more string input
GCH1:	XCTUU [HLRZ A,1(E)]
	TLNE E,777777
	TLNE E,2
	CAIN A,377777		; Is there an input file?
	POPJ P,			; No, error return
	BIN			; Yes get a byte
	MOVE A,B
	Cain	A,4		; ^D?
	Movei	A,37		; Yes...make it EOL.
	AOS (P)
	POPJ P,

; Assign a jfn
; Call:	PUSHJ P,ASGJFN
; Return
;	+1	; Error none available
;	+2	; Ok, in jfn the jfn
; Clobbers jfn

ASGJFN:	NOINT
	LOCK JFNLCK
	MOVN JFN,MAXJFN		; Get current max jfn
	HRLZS JFN		; Form aobjn pointer
	JUMPGE JFN,ASGJF2	; Run out of jfns
ASGJF0:	SKIPN FILSTS(JFN)
	 JRST ASGJF3		; This one is free
ASGJF5:	ADD JFN,[XWD 1,1_SJFN]
	JUMPL JFN,ASGJF0
ASGJF2:	CAIL JFN,RJFN
	 JRST ASGJF4
	SUB JFN,[XWD 1,0]
	AOS MAXJFN
ASGJF3:	HRRZ A,JFN
	JUMPE A,ASGJF9		;DON'T GIVE OUT JFN 0 UNLESS ASKED
	CAIE A,101_SJFN
	CAIN A,100_SJFN
	 JRST ASGJF5		; Primary io designator is skipped
	AOS (P)
ASGJF1:	HRLI JFN,ASGF
	HLLZM JFN,FILSTS(JFN)	; Mark this jfn as assigned
	HRRZS JFN
	HRRZ A,FORKN		; Get fork number
	HRLZM A,FILVER(JFN)
	SETZM FILTMP(JFN)
	SETZM FILPRT(JFN)
	SETZM FILACT(JFN)
	SETZM FILDDN(JFN)
	SETZM FILNEN(JFN)
	SETZM FILDNW(JFN)	; Clear Dir and Name wild cards
	SETZM FILEXW(JFN)	; Clear retype buffer
	SETOM FILLCK(JFN)
ASGJF4:	UNLOCK JFNLCK
	OKINT
	POPJ P,

ASGJF9:	SETZM FILSTS(JFN)	;MAKE JFN 0 UNUSED BUT LEGAL STATE
	SETZM FILVER(JFN)
	SETZM FILTMP(JFN)
	SETZM FILDDN(JFN)
	SETZM FILNEN(JFN)
	SETOM FILLCK(JFN)	;UNLOCK FT
	JRST ASGJF5		;AND GO PICK ANOTHER JFN, NOT 0

; Release jfn
; Call:	IN JFN, JFN
;	PUSHJ P,RELJFN
; Clobbers a,b,c,d

RELJFN::NOINT
	LOCK JFNLCK
	SKIPN FILSTS(JFN)
	JRST RELJF2		; Already released
	MOVEI A,JSBFRE
	HLRZ B,FILDDN(JFN)
	SKIPE B
	PUSHJ P,RELFRE		; Release device string block
	HLRZ B,FILNEN(JFN)
	SKIPE B
	PUSHJ P,RELFRE		; Release name string block
	HRRZ B,FILNEN(JFN)
	SKIPE B
	PUSHJ P,RELFRE		; Release extension string block
	HLRZ B,FILDNW(JFN)
	SKIPE B
	PUSHJ P,RELFRE		; Release Directory wild card block
	HRRZ B,FILDNW(JFN)
	SKIPE B
	PUSHJ P,RELFRE		; Release Name wild card block
	HLRZ B,FILEXW(JFN)
	SKIPE B
	PUSHJ P,RELFRE		; Release Extension wild card block
	MOVE B,FILSTS(JFN)
	TLNN B,ASGF		; Was this jfn being assigned?
	JRST RELJF2		; No, skip the following
	HRRZ B,FILTMP(JFN)
	SKIPE B
	PUSHJ P,RELFRE		; Release temp block
	HLRZ B,FILTMP(JFN)
	SKIPE B
	PUSHJ P,RELFRE
	HRRZ B,FILEXW(JFN)
	SKIPE B
	PUSHJ P,RELFRE		; Release retype buffer
	MOVE B,FILPRT(JFN)
	JUMPE B,RELJF1
	TLNN B,777777
	PUSHJ P,RELFRE		; Release space for protection block
RELJF1:	MOVE B,FILACT(JFN)
	JUMPE B,RELJF2
	TLNN B,777777
	PUSHJ P,RELFRE		; Release storage for account string
RELJF2:	SETZM FILDDN(JFN)
	SETZM FILNEN(JFN)
	SETZM FILPRT(JFN)
	SETZM FILACT(JFN)
	SETZB STS,FILSTS(JFN)
	SETZM FILDNW(JFN)
	SETZM FILEXW(JFN)
	SETOM FILLCK(JFN)
	UNLOCK JFNLCK
	OKINT
	POPJ P,

; Terminate string
; Call:	FILOPT(JFN)	; Addresses last byte of string
;	RH(FILTMP(JFN))	; Addresses beginning of string block
;	PUSHJ P,ENDSTR
; Returns with a null deposited on the end of the string and
; In a, a pointer to the string as required by the recognition routines
; Does not modify filopt(jfn), clobbers a,b

ENDSTR::MOVE A,FILOPT(JFN)
	MOVEI B,0
	IDPB B,A		; Append null to string
	SUB A,FILTMP(JFN)
	MOVNI A,-1(A)		; Number of full words instring
	HRL A,FILTMP(JFN)
	MOVSS A			; Yields iowd # fuul words, first word
	POPJ P,

; Trim temp storage block and return excess to free store pool
; Call:	FILOPT(JFN)	; Addresses the last byte of the string
;	RH(FILTMP(JFN))	; Addresses the beginning of the string block
;	PUSHJ P,ENDTMP
; Returns in a, origin of the string block
; Deposits a null byte on the end of the string
; Returns excess storage in the block to free storage pool
; Clears rh(filtmp(jfn))
; Clobbers a,b,c,d
; Leaves psi off

ENDTMP:	MOVEI B,0
	IDPB B,FILOPT(JFN)	; Deposit a null on the end
	HRRZ A,FILTMP(JFN)	; Origin of block
	MOVE B,FILOPT(JFN)
	PUSHJ P,TRMBLK		; Trim excess from the block
	NOINT
	HRRZ A,FILTMP(JFN)
	HLLZS FILTMP(JFN)
	POPJ P,

; Trim excess from a block and return it to free storage
; Call:	A		; Origin of the block
;	RH(B)		; Last location in block used
;	PUSHJ P,TRMBLK
; Clobbers a,b,c,d

TRMBLK::MOVEI B,1(B)		; Loc of first unused word
	HRRE C,(A)		; Original length of block
	SUBI C,(B)
	ADDI C,(A)		; Length of excess
	JUMPLE C,CPOPJ		; No excess
	NOINT
	HRROM C,(B)		; Make residue into legit block
	MOVNS C
	ADDM C,(A)		; Shorten original block
	MOVEI B,(B)
	MOVEI A,JSBFRE
	PUSHJ P,RELFRE		; Release the residue
	OKINT
	POPJ P,


; I-o routines for local use
; Call:	B		; Pointer to string to be typed
;	PUSHJ P,TSTRB	; If b addresses a string block
; Or
;	PUSHJ P,TSTR	; If b address the first byte
; Outputs the string to the file specified in the call to gtjfn
; Clobbers a,b

TSTRB:	ADD B,[XWD 777777,1]
TSTR:	XCTUU [HRRZ A,1(E)]
	TLNE E,777777
	TLNE E,2
	CAIN A,377777
	POPJ P,
	MOVEI C,0
	SOUT
	POPJ P,


; Here when an attempt is made to delete past the start of the input.
; Error returned if requested by extended long GTJFN.  Otherwise, just
; ding him.
RDING:	HRRZ B,FILEXW(JFN)	; Request break?
	MOVE B,BLKFG(B)
	TRNN B,BRDEL
	JRST DING		; No, just ding him
	ERRLJF GJFX40		; Yes, give him error


; Ding the bell
; Call:	PUSHJ P,DING

DING:	XCTUU [HLRZ A,1(E)]
	TLNE E,777777
	TLNE E,2
	CAIN A,377777
	POPJ P,
	MOVEI B,7
	jrst outch		; Go finish outputting the bell


; Output character
; Call:	B		; The character right justified
;	PUSHJ P,OUTCH
; Outputs the character on the file specified in the call to gtjfn
; Clobbers a

OUTCH:	XCTUU [HRRZ A,1(E)]
	TLNE E,777777
	TLNE E,2
	CAIN A,377777
	POPJ P,
	BOUT
	POPJ P,

INFTST:	XCTUU [HLRZ A,1(E)]
	TLNE E,777777
	TLNE E,2
	CAIN A,377777
	POPJ P,
	JRST SKPRET

SFCC0:	MOVE B,[BYTE (2)1,0,1,1,1,1,0,2,1,0,0,1,0,0,1,1,1,1]
	MOVE C,[BYTE (2)0,1,1,1,0,0,0,1,1,0,1,1,1,0]
SFCC:	PUSHJ P,INFTST
	POPJ P,
	SFCOC
	POPJ P,

; Output number
; Call:	B		; The number
;	PUSHJ P,DNOUT	; For decimal output
; Or
;	PUSHJ P,ONOUT	; For octal output
; Clobbers a,c

DNOUT:	SKIPA C,[12]
ONOUT:	MOVEI C,10
	XCTUU [HRRZ A,1(E)]
	TLNE E,777777
	TLNE E,2
	CAIN A,377777
	POPJ P,
	NOUT
	POPJ P,
	POPJ P,


; Process errors during gtjfn
; Call:	A	; Error number
;	JRST ERRDO

ERRDO1:	MOVEM A,LSTERR		;COME HERE IF JFN NOT AT ALL SET UP
	JRST ERRDO2
ERRDO:	MOVEM A,LSTERR
	PUSHJ P,ENDJFN
	MOVE A,LSTERR
ERRDO2:	UMOVEM A,1
	PUSHJ P,INFTST
	JRST MRTNE1##
	MOVE A,MPP
	ADD A,[XWD 4,4]
	MOVE P,A
	POP P,A
	POP P,B
	SFMOD
	POP P,C
	POP P,B
	SFCOC
	jrst mrtne1

; Get next jfn
; Call:	LH(1)	; Flags dirsf...hverf
;	RH(1)	; Jfn
;	GNJFN
; Returns
;	+1	; Error, jfn not attached to name, no more names
;	+2	; Ok, the jfn refers to the next file in the directory

; Mask of bits to keep from user file handle

GNJMSK=DIRSF!NAMSF!EXTSF!VERSF!RVERF!HVERF!LVERF!FXPRT!FXACT!FXTMP!EXTXF

.GNJFN::JSYS MENTR
	HRRZ JFN,1
	PUSHJ P,CHKJFN
	ERR()
	JFCL
	ERR(DESX4)
	TEST(NE,ASTF)
	 ERUNLK(DESX7)			; Output stars not allowed
	TEST(NN,OPNF)
	JRST GNJFN0
	 ERUNLK(OPNX1)
GNJFN0:	SETZB F,F1			; Clear flag bits
GNJFN1:	SETZM FILTMP(JFN)
	SETZM FILPRT(JFN)
	SETZM FILACT(JFN)
	SETZM FILOPT(JFN)
	XCTUU [HLL F1,1]
	AND F1,[GNJMSK,,DIRXF!NAMXF]	; Keep only defined bits
	TEST(NN,NAMSF)			; Name steppable?
	 JRST GNJF1A			; No, try extension
	HLRZ A,FILNEN(JFN)		; Yes, make sure full-size block
	PUSHJ P,FULBLK
	HRLM A,FILNEN(JFN)		; Save full sized block
	OKINT				; Restore interrupts
GNJF1A:	TEST(NN,EXTSF)			; Extension steppable?
	 JRST GNJF1B			; No, set/check flags
	HRRZ A,FILNEN(JFN)		; Yes, make sure full size block
	PUSHJ P,FULBLK
	HRRM A,FILNEN(JFN)		; Save full sized block
	OKINT				; Restore interrupts
GNJF1B:	UMOVE B,1			; Do we allow deleted files?
	TLNN B,(1B12)
	TEST(O,IGDLF)			; Yes, set flag
	TEST(O,OLDNF)			; Old files only
	TEST(O,STEPF)			; And step to next one
	HRRZ A,FILVER(JFN)		; Set up version specification
	TEST(NE,HVERF)
	MOVNI A,1
	TEST(NE,RVERF)
	MOVNI A,0
	TEST(NE,LVERF)
	MOVNI A,2
	TLNE F1,DIRSF!NAMSF!EXTSF!VERSF	; Stepping anything?
	PUSHJ P,GTVER		; Go try to find another file
	 JRST	[PUSHJ P,RELJFN	; No more, release the JFN
		 MOVEI A,0(DEV)	; If this is not TTY:
		 CAIE A,TTYDTB
		 OKINT		; Reenable interrupts (from CHKJFN)
		 ERR(GNJFX2)]	; And report the error
	PUSHJ P,UNLCKF
	SETZ A,
	TEST(NE,DIRXF)
	TLO A,(1B14)
	TEST(NE,NAMXF)
	TLO A,(1B15)
	TEST(NE,EXTXF)
	TLO A,(1B16)
	XCTUU [HLLM A,1]
	JRST SKMRTN

; Continue assembly from GTJSMX.MAC...